Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyNewPreferences.p

Text File | 1995-10-24 | 5.9 KB | 223 lines | [TEXT/CWIE]

unit MyNewPreferences;

interface

    uses
        Files, MyCollections;

    var
        the_prefs_folder_vrn: integer;
        the_prefs_folder_dirID: longint;
        prefs_fs: FSSPec;
        prefs: collection;

    procedure InitNewPreferences(strhId, folderindex, fileindex: integer; fcreator: OSType);
    procedure FinishPreferences;
    procedure DeletePrefsFile;
    function WritePrefsData: OSErr;
    procedure ReadPrefsData;
    procedure JustReadPrefsData;
    procedure ReadPrefsCollection (c: collection; res_id: integer);
    function WritePrefsCollection (c: collection; res_id: integer): OSErr;
    function PutResource (hhhh: handle; typ: ResType; id: integer): OSErr; { handle remains unchanged, and is detatched }
    procedure ReadPrefsHandle (var hhhh: handle; typ: ResType; id: integer);
    function WritePrefsHandle (hhhh: handle; typ: ResType; id: integer): OSErr;
    procedure SetDefaultLong (code: OSType; def: longint);

implementation

    uses
        Resources, GestaltEqu, Folders, AppleTalk, Aliases, TextUtils,
        MyFileSystemUtils, MyFDFlags;

    const
        prefs_restype = 'PRFN';
        prefs_resid = 128;
        prefs_type = 'pref';

    var
        prefs_creator: OSType;
        prefs_mdate: longint;

    procedure DeletePrefsFile;
        var
            junk: OSErr;
    begin
        junk := HDelete(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name);
    end;

    procedure ReadPrefsHandle (var hhhh: handle; typ: ResType; id: integer);
        var
            resfile: integer;
    begin
        resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdPerm);
        hhhh := GetResource(typ, id);
        if hhhh <> nil then begin
            DetachResource(hhhh);
        end;
        if resfile <> -1 then begin
            CloseResFile(resfile);
        end;
    end;

    procedure ReadPrefsCollection (c: collection; res_id: integer);
        var
            hhhh: handle;
    begin
        ReadPrefsHandle(hhhh, prefs_restype, res_id);
        if hhhh <> nil then begin
            HackUpdateHandleToCollection(hhhh);
            c.SetDataHandle(hhhh);
        end;
    end;

    procedure JustReadPrefsData;
    begin
        ReadPrefsCollection(prefs, prefs_resid);
        prefs.safeget := true;
    end;

    function PutResource (hhhh: handle; typ: ResType; id: integer): OSErr;
        var
            err: OSErr;
            old: handle;
            xid: integer;
            xtyp: ResType;
            name: Str255;
    begin
        name := '';
        old := Get1Resource(typ, id);
        if old <> nil then begin
            GetResInfo(old, xid, xtyp, name);
            RemoveResource(old);
            DisposeHandle(old);
        end;
        AddResource(hhhh, typ, id, name);
        err := ResError;
        if err = noErr then begin
            WriteResource(hhhh);
            err := ResError;
            DetachResource(hhhh);
        end;
        PutResource := err;
    end;

    function WritePrefsHandle (hhhh: handle; typ: ResType; id: integer): OSErr;
        var
            err, junk: OSErr;
            resfile: integer;
    begin
        junk := HCreate(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, prefs_creator, prefs_type);
        HCreateResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name);
        resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdWrPerm);
        err := ResError;
        if resfile <> -1 then begin
            err := PutResource(hhhh, typ, id);
            CloseResFile(resfile);
            junk := FlushVol(nil, prefs_fs.vRefNum);
        end;
        WritePrefsHandle := err;
    end;

    function WritePrefsCollection (c: collection; res_id: integer): OSErr;
        var
            hhhh: handle;
    begin
        hhhh := c.GetDataHandle;
        WritePrefsCollection := WritePrefsHandle(hhhh, prefs_restype, res_id);
    end;

    function WritePrefsData: OSErr;
    begin
        WritePrefsData := WritePrefsCollection(prefs, prefs_resid);
    end;

    procedure ReadPrefsData;
        var
            nmoddate: longint;
    begin
        MyGetModDate(prefs_fs, nmoddate);
        if nmoddate <> prefs_mdate then begin
            prefs_mdate := nmoddate;
            JustReadPrefsData;
        end;
    end;

    procedure FixPrefType;
        var
            fi: FInfo;
            err: OSErr;
    begin
        err := HGetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
        if (err = noErr) & (fi.fdCreator = prefs_creator) & (fi.fdType <> prefs_type) then begin
            fi.fdType := prefs_type;
            fi.fdFlags := BAND(fi.fdFlags, BNOT(fdInited));
            err := HSetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
        end;
    end;

    procedure SetDefaultLong (code: OSType; def: longint);
    begin
        if not prefs.ExistsTag(code) then begin
            prefs.SetTagLong(code, def);
        end;
    end;

    procedure InitNewPreferences(strhId, folderindex, fileindex: integer; fcreator: OSType);
        var
            gv: longint;
            oe: OSErr;
            pb: CInfoPBRec;
            sysenv: SysEnvRec;
            name: Str255;
            dummy: longint;
            our_prefs_folder_vrn: integer;
            our_prefs_folder_dirID: longint;
    begin
        prefs_creator := fcreator;
        new(prefs);
        prefs.Create(0, false, true);
        prefs.safeget := true;

{ First Find the Preferences Folder }
        if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, the_prefs_folder_vrn, the_prefs_folder_dirID) <> NoErr) then begin
            oe := SysEnvirons(1, sysenv);
            the_prefs_folder_vrn := sysenv.sysVRefNum;
            the_prefs_folder_dirID := 0;
            name := 'Preferences';
            oe := DirCreate(the_prefs_folder_vrn, the_prefs_folder_dirID, name, dummy);
            oe := MyGetCatInfo(the_prefs_folder_vrn, the_prefs_folder_dirID, name, 0, pb);
            if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
                the_prefs_folder_vrn := pb.ioVRefNum;
                the_prefs_folder_dirID := pb.ioDirID;
            end;
        end;

{ Then our folder, if any }
        our_prefs_folder_vrn := the_prefs_folder_vrn;
        our_prefs_folder_dirID := the_prefs_folder_dirID;
        if folderindex > 0 then begin
            GetIndString(name, strhId, folderindex);
            oe := DirCreate(our_prefs_folder_vrn, our_prefs_folder_dirID, name, dummy);
            oe := MyGetCatInfo(our_prefs_folder_vrn, our_prefs_folder_dirID, name, 0, pb);
            if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
                our_prefs_folder_vrn := pb.ioVRefNum;
                our_prefs_folder_dirID := pb.ioDirID;
            end;
        end;

        GetIndString(name, strhId, fileindex);
        oe := MyFSMakeFSSpec(our_prefs_folder_vrn, our_prefs_folder_dirID, name, prefs_fs);

        FixPrefType;

        MyGetModDate(prefs_fs, prefs_mdate);
        JustReadPrefsData;
    end;

    procedure FinishPreferences;
    begin
        prefs.Destroy;
    end;

end.